home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
yerk 3.66
/
System source
/
Struct
< prev
next >
Wrap
Text File
|
1994-06-24
|
5KB
|
183 lines
\ Modification History - This file contains data primitives
\ 4/11/84 CBD Version 1.00
\ 4/26/84 CBD Added +TO: for all indexed objects
\ 4/26/84 CBD Optimized fetches and stores with code
\ 4/27/84 CBD Changed Ordered-Col to work right
\ 4/28/84 CBD Added INT: method for Ints
\ 5/23/84 NDI OBJECT read & write methods
\ 5/25/84 NDI File handling moved from File.scr
\ 6/10/84 CBD Moved EVENT class into STRUCT
\ 6/10/84 CBD Added CLEAR: method for arrays
\ 6/11/84 NDI Swapped stack input for read & write
\ 8/08/84 CBD Added default ClassInit: method to Object
\ 10/10/84 CBD Removed Object to Object.scr
\ 10/11/84 CBD Removed File to file.scr
\ 10/12/84 CBD Removed Set:, Dispatch: is now Exec:
\ 10/12/84 CBD Methods no longer pull names from input stream
\ 10/12/84 CBD Ordered-collection is simpler and faster
\ 10/30/84 CBD Moved Var to Object.scr
\ 11/20/84 CBD Ordered-Col is subclass of X-Array; more handle methods
\ 11/22/84 cbd Added wordCol
\ 12/08/84 cbd ß1.0 version
\ 11/04/85 cdn Added $= ; Fixed new: method in Array
\ 9/26/86 cdn Added check for 0 handle in release: handleobj
\ 3/08/88 rfl lock: handle does not keep the pointer; added unlock etc
\ 7/02/90 rfl added moveHi to lock (as in IMAC)
\ 9/27/90 rfl added hgetstate and hsetstate to handle
\ 12/13/90 rfl made locked?: clean as in MOPS
\ 2/22/91 rfl added negate: to int and var
\ 4/30/93 rfl added valid: to handle; setsize!: preserves handle state
Decimal
' null cfa value nullCfa
\ handy handle primitives
create unlock ( h --) $ 205f w, $ a02a w, next,
create hgetstate ( -- st) popa0 $ a069 w, pushd0 next,
create hsetstate ( st h --) popa0 popd0 $ a06a w, next,
create reserveMem ( --) $ 201f w, $ a040 w, next,
create moveHi ( h --) popA0 $ a064 w, next,
\ =========== Variables =============
:CLASS Int <Super Object
2 BYTES DATA
:M CLEAR: 0 MW! ;M
:M GET: MW@ ;M \ Fetch
:M INT: MW@ makeInt ;M \ Return as toolbox INT
:M UGET: MW@ $ ffff and ;M \ get as unsigned
:M PUT: MW! ;M \ Store
:M +: COPYM W+! ;M \ add value to a word
:M PRINT: MW@ . ;M
:M =: MW@ swap W! ;M \ addr =: int
:M NEGATE: MW@ negate MW! ;M
;CLASS
\ Define the basic 4-byte variable class
:CLASS Var <Super Object
4 BYTES Data
:M CLEAR: 0 M! ;M
:M GET: M@ ;M
\ ( -- ^obj ) get contents as an object pointer
:M OBJ: M@ dup 0= classErr" 157 ;M \ invalid obj addr
:M PUT: M! ;M
:M +: COPYM +! ;M
:M PRINT: M@ . ;M
:M DISPOSE: copym dispose ;M \ dispose of heap ptr
:M EXEC: M@ dup 0= classErr" 131 execute ;M
:M =: M@ swap ! ;M \ r to l assignment to address
:M NEGATE: M@ negate M! ;M
;CLASS
\ Handle class can store handles to relocatable heap blocks.
:CLASS Handle <Super Var
:M VALID: ( -- b) m@ ?ishandle ;M
:M LOCKED?: ( -- b) m@ hGetState $ 80 and ;M
:M GETSTATE: ( -- st) m@ hGetState ;M
:M SETSTATE: ( st --) m@ hSetState ;M
:M LOCK: m@ moveHi m@ lock drop ;M \ lock the heap and don't keep rel. ptr
:M UNLOCK: m@ unlock ;M
:M PTR: m@ >ptr ;M \ return relative pointer from handle
:M RELEASE: m@ -dup IF killHandle 0 m! THEN ;M \ dispose of heap
\ ( size -- ) set new size for handle
:M SETSIZE: m@ swap setHSize ?error 166 ;M \ SetHandleSize failed
\ ( size -- ) set new size for handle - If handle is locked, still works
:M SETSIZE!: m@ hGetState m@ rot m@ unlock setHSize swap m@ hSetState
?error 166 ;M \ SetHandleSize failed
\ ( -- size ) return current size
:M SIZE: get: self getHSize ;M
\ ( len -- ) obtain handle to Len bytes of heap and store it in data
:M NEW: newHandle m! ;M
:M MOVEHI: m@ moveHi ;M
\ ( -- tf)
;CLASS
\ ============= Arrays =============
\ Basic 4-byte cell array
:CLASS Array <Super Object 4 <Indexed
\ uses basic methods defined in Object
\ ( ind -- ) return relative pointer from handle
:M PTR: AT4 >ptr ;M
\ ( ind -- ) dispose of non-relocatable heap
:M DISPOSE: ^elem dispose ;M
\ ( ind -- ) dispose of relocatable heap
:M RELEASE: dup at: self killHandle
0 swap to: self ;M
\ ( ind len -- ) obtain ptr to Len bytes of heap and store it in data
:M NEW: newPtr swap TO4 ;M
;CLASS
\ x-Array can execute its elements
:CLASS X-Array <Super Array
\ ( ind -- ) execute the cfa at Ind
:M EXEC: AT: SELF dup 0=
classErr" 131 EXECUTE ;M
:M CLASSINIT: limit 0
DO nullCfa i To: self LOOP ;M
;CLASS
\ =========== Lists ===========
\ Ordered-Collection is an ordered list with current size
:CLASS Ordered-Col <Super X-Array 4 <Indexed
Int Size \ # elements in list
\ ( -- curSize ) Return #elements currently in list
:M SIZE: Get: Size ;M
\ ( -- ) set to null list
:M CLEAR: Clear: Size Clear: Super ;M
\ ( val -- ) Add value to end of list
:M ADD: Get: Size limit >=
classErr" 137 Get: size To: Self
1 +: Size ;M
\ ( -- ^file ) return contents of end of list
:M LAST: get: size dup 0= classerr" 136
1- at: self ;M
\ ( ind -- ) remove the element at index
:M REMOVE: { ind -- } ind Get: size >=
classErr" 136 Get: size 1- ind
DO I 1+ at: self I to: self LOOP -1 +: size ;M
\ ( val -- ind t OR f) Find a value in an OC
:M INDEXOF: 0 swap Get: Size 0
DO I at4
over = IF 2drop I 1 1 leave THEN
LOOP drop ;M
;CLASS
: $= { addr1 len1 addr2 len2 -- }
word0 addr1 +base addr2 +base len1 len2 pack w 10
$ a9ed Trap i->l ;
<" BasicStr